Amiga News 95/Amiga News 95.iso/dpat/dpat96/klondike_adptools_v1.1/datas/english.lha/1-ScaleCards.adpro

Text File | 1995-04-11 | 6KB | 279 lines

/*
** ScaleCards.adpro :
**  This ARexx script for ADPro v2.5 or higher scales selected pictures to
**  86x128 pixels and save then to IFF 24 bits.
**
** $VER: ScaleCards/English v1.1 (06.04.95) © Copyright Lejardinier Olivier - All rights reserved
**
*/

 ADDRESS "ADPro"
 OPTIONS RESULTS

 NL = '0A'X
 FALSE = 0
 TRUE = 1

/*
** Save the current environment.
*/

 TempDefaults = "T:TempADProDefaults"
 SAVE_DEFAULTS TempDefaults

/*
** Initializations.
*/

 CLOSE_RENDER_SCREEN
 CLEAR_RENDERED
 CLEAR_RAW
 PSTATUS "UNLOCKED"
 ADPRO_TO_FRONT

 MemoryError = "Perhaps not enought memory."
 FileMemError = "Perhaps file corrupted or not enought memory."
 DiskSpaceError = "Perhaps not enought disk space."

/*
** Get some cards files.
*/

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETFILES '"Select some cards files :"'
  IF ( RC ~= 0 ) THEN
   DO
    OKAYN '"Error :"' '"You MUST select some cards files !"' '"Select|Abort"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
   END
  ELSE
   DO
    CardsFiles = ADPRO_RESULT
    NbCards = WORDS( CardsFiles )
    Continue = TRUE
   END
 END

 SourceDir = WORD( CardsFiles , 1 )
 FirstChar = LEFT( SourceDir , 1 )
 IF ( (FirstChar = '"') | (FirstChar = '''') ) THEN
  SourceDir = STRIP( SourceDir , "B" , FirstChar )

 FNameSepPos = LASTPOS( '/' , SourceDir )
 IF (FNameSepPos = 0) THEN
  FNameSepPos = LASTPOS( ':' , SourceDir )

 IF (FNameSepPos ~= 0) THEN
  DO
   Basename = RIGHT( SourceDir , LENGTH( SourceDir ) - FNameSepPos )
   SourceDir = LEFT( SourceDir , FNameSepPos )
   IF ( LASTPOS( '.'  , Basename ) ~= 0 ) THEN
    Basename = DELSTR( Basename , LASTPOS( '.'  , Basename ) )
  END
 ELSE
  DO
   SourceDir = ""
   Basename = "Cards"
  END

/*
** Get destination directory.
*/

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETDIR '"Select output directory :"' '"'SourceDir'"'
  IF ( RC ~= 0 ) THEN
   DO
    Text = "Use :" || NL || SourceDir || NL || "as output directory ?"
    OKAYN '"Confirm :"' '"'Text'"' '"Use|Select|Abort"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
    ELSE
     IF ( RC = 1 ) THEN
      DO
       DestDir = SourceDir
       Continue = TRUE
      END
   END
  ELSE
   DO
    DestDir = ADPRO_RESULT
    Continue = TRUE
   END
 END

 FirstChar = LEFT( DestDir , 1 )
 IF ( ( FirstChar = '"' ) | ( FirstChar = '''' ) ) THEN
  DestDir = STRIP( DestDir , "B" , LEFT( DestDir, 1 ) )

 LastChar = RIGHT( DestDir , 1 )
 IF ( ( LastChar ~= "/" ) & ( LastChar ~= ":" ) ) THEN
   DestDir = DestDir || "/"

/*
** Select cards base name.
*/

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETSTRING '"Enter cards base name :"' '"'Basename'"'
  IF ( RC ~= 0 ) THEN
   DO
    OKAYN '"Confirm :"' '"Use 'Card' as cards base name ?"' '"Use|Select|Abort"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
    ELSE
     IF ( RC = 1 ) THEN
      DO
       Basename = "Card"
       Continue = TRUE
      END
   END
  ELSE
   DO
    Basename = ADPRO_RESULT
    Continue = TRUE
   END
 END

/*
** Get counter starting.
*/

 Counter = 1
 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETNUMBER '"Start counter at ?"' Counter 1 999-NbCards
  IF ( RC ~= 0 ) THEN
   DO
    Text = "Start counter at" Counter ", or ABORT ?"
    OKAYN '"Confirm :"' '"'Text'"' '"Use|Abort"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
    ELSE
     Continue = TRUE
   END
  ELSE
   DO
    Counter = ADPRO_RESULT
    Continue = TRUE
   END
 END

/*
** Load, scale & save cards file to IFF24.
*/

 Index = 1
 LOAD_TYPE '"REPLACE"'

 DO WHILE ( Index <= NbCards )

  Cardname = WORD( CardsFiles, Index )

  Continue = FALSE
  DO UNTIL ( Continue = TRUE )

   LOADER '"UNIVERSAL"' Cardname
   IF ( RC ~= 0 ) THEN
    DO
     Text = "Unable to load :" || NL || STRIP( Cardname , B , '"' ) || NL || MemoryError
     OKAYN '"Error :"' '"'Text'"' '"Retry|Skip|Abort"'
     IF ( RC = 0 ) THEN
      CALL ForceExit
     ELSE
      IF ( RC = 2 ) THEN
       DO
        Index = Index + 1
        IF ( Index > NbCards ) THEN
         DO
          OKAY1 "No more card file to load..."
          CALL ForceExit
         END
        ELSE
         Cardname = WORD( CardsFiles , Index )
       END
     IF ( RC = 0 ) THEN CALL ForceExit
    END
   ELSE
    Continue = TRUE
  END

  Continue = FALSE
  DO UNTIL ( Continue = TRUE )
   ABS_SCALE 86 128
   IF ( RC ~= 0 ) THEN
    DO
      Text = "Unable to scale :" || NL || STRIP( Cardname , B , '"' ) || NL || MemoryError
      OKAYN '"Error "' '"'Text'"' '"Retry|Skip|Abort"'
      IF ( RC = 0 ) THEN
       CALL ForceExit
      ELSE
       IF ( RC = 2 ) THEN
        DO
         Continue = TRUE
         Index = Index + 1
        END
     END
    ELSE
     Continue = TRUE
  END

  IF ( Counter < 10 ) THEN
   Savename = DestDir || Basename || ".00" || Counter
  ELSE
   IF ( Counter < 100 ) THEN
    Savename = DestDir || Basename || ".0" || Counter
   ELSE
    Savename = DestDir || Basename || "." || Counter

  Continue = FALSE
  DO UNTIL ( Continue = TRUE )
   SAVER '"IFF"' Savename "RAW"
   IF ( RC ~= 0 ) THEN
    DO
     Text = "Unable to save scaled card :" || NL || STRIP( Cardname , B , '"' ) || NL || DiskSpaceError
     OKAYN '"Error :"' '"'Text'"' '"Retry|Skip|Abort"'
     IF ( RC = 0 ) THEN
      CALL ForceExit
     ELSE
      IF ( RC = 2 ) THEN
     DO
      Continue = TRUE
      Index = Index + 1
     END
    END
   ELSE
    DO
     Continue =TRUE
     Index = Index + 1
     Counter = Counter + 1
    END
  END
 END

/*
** Quit.
*/

ForceExit:

 CLOSE_RENDER_SCREEN
 CLEAR_RENDERED
 CLEAR_RAW

 IF ( EXISTS( TempDefaults ) ) THEN
  DO
   LOAD_DEFAULTS TempDefaults
   IF ( RC ~= 0 ) THEN
    OKAY1 "Error restoring settings."
   ADDRESS COMMAND "C:Delete >NIL: FILE" TempDefaults "QUIET"
  END

 EXIT 0

RETURN